Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/stomp/stomp2.frm

Text File | 1995-09-06 | 8KB | 274 lines

VERSION 2.00
Begin Form FileDlg
   BorderStyle     =   1  'Fixed Single
   Caption         =   "File"
   ClientHeight    =   4170
   ClientLeft      =   1500
   ClientTop       =   1635
   ClientWidth     =   5790
   ControlBox      =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Times New Roman"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4575
   Left            =   1440
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4170
   ScaleWidth      =   5790
   Top             =   1290
   Width           =   5910
   Begin TextBox FileEdit
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   1560
      TabIndex        =   0
      Text            =   "*.*"
      Top             =   240
      Width           =   2790
   End
   Begin CommandButton Ok
      Caption         =   "OK"
      Default         =   -1  'True
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   4470
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin CommandButton Cancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   4470
      TabIndex        =   3
      Top             =   660
      Width           =   1215
   End
   Begin FileListBox File1
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2280
      Left            =   315
      TabIndex        =   10
      Top             =   1515
      Width           =   1695
   End
   Begin ListBox DirList
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2280
      Left            =   2400
      TabIndex        =   5
      Top             =   1515
      Width           =   1695
   End
   Begin DirListBox Dir1
      Height          =   1500
      Left            =   5070
      TabIndex        =   9
      Top             =   2040
      Visible         =   0   'False
      Width           =   2490
   End
   Begin DriveListBox Drive1
      Height          =   1575
      Left            =   5085
      TabIndex        =   8
      Top             =   3630
      Visible         =   0   'False
      Width           =   2460
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "File&name:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   330
      TabIndex        =   1
      Top             =   315
      Width           =   1080
   End
   Begin Label DirLabel
      Caption         =   "c:\"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   315
      Left            =   345
      TabIndex        =   7
      Top             =   750
      Width           =   5400
   End
   Begin Label Label2
      Caption         =   "&Files:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      Left            =   330
      TabIndex        =   4
      Top             =   1200
      Width           =   615
   End
   Begin Label Label3
      Caption         =   "&Directories:"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   270
      Left            =   2385
      TabIndex        =   6
      Top             =   1170
      Width           =   1500
   End
End
Sub Cancel_Click ()
    ' if we select Cancel, we can unload the dialog since
    ' we don't need it anymore
    fileedit.text = ""
    Hide
End Sub

Sub DirList_DblClick ()
    Const MB_RETRYANDCANCEL = 5
    Const MB_ICONEXCLAMATION = 48

    On Local Error GoTo UhOh

    ' when you double-click on a directory or drive entry,
    ' check to see if the selected item is a drive; if so,
    ' change the current drive
    If Left$(DirList.text, 2) = "[-" And Len(DirList.text) = 5 Then
        oldDir$ = CurDir$
        ChDrive Mid$(DirList.text, 3, 1)
        A$ = CurDir$    ' check to see if the disk is ready
    ' otherwise, change the current directory
    Else
        ChDir Mid$(DirList.text, 2, Len(DirList.text) - 2)
    End If

    On Local Error GoTo 0

    Update_List_Boxes
    Exit Sub

UhOh:
    If MsgBox("Unable to switch to drive " + Mid$(DirList.text, 3, 1) + ":", MB_RETRYANDCANCEL + MB_ICONEXCLAMATION, "Visual Basic - FileDlg") = 2 Then
    ' if we press Cancel, go back to the previous drive
            ChDrive Left$(oldDir$, 1)
    End If

    Resume
End Sub

Sub File1_Click ()
    fileedit.text = File1.FileName
End Sub

Sub File1_DblClick ()
    fileedit.text = File1.FileName
  ok_click
End Sub

Sub Form_GotFocus ()
    Update_List_Boxes
End Sub

Sub Form_Load ()
    Update_List_Boxes
End Sub

Sub ok_click ()
    If InStr(fileedit.text, "*") Or InStr(fileedit.text, "?") Then
        Update_List_Boxes
    Else
        If which = 1 Then
            form1.text1.text = Trim(fileedit.text)
        Else
            form1.text2.text = Trim(fileedit.text)
        End If
        Unload Me
    End If
End Sub

Sub Update_List_Boxes ()

    DirLabel.Caption = LCase$(CurDir$)


    File1.Path = CurDir$


    File1.Pattern = fileedit.text
    Do While DirList.ListCount
        DirList.RemoveItem 0
    Loop


    If Right$(CurDir$, 1) <> "\" Then DirList.AddItem "[..]"

    Dir1.Path = CurDir$
    For I = 0 To Dir1.ListCount - 1
        A$ = Dir1.List(I)
        For J = Len(A$) To 1 Step -1
            If Mid$(A$, J, 1) = "\" Then
                A$ = Mid$(A$, J + 1)
                Exit For
            End If
        Next


        DirList.AddItem "[" + A$ + "]"
    Next

    For I = 0 To Drive1.ListCount - 1
        DirList.AddItem "[-" + Mid$(Drive1.List(I), 1, 1) + "-]"
    Next
End Sub